401-2_Homework4

Author

Cat Dang Ton

Published

May 1, 2024

1A

note from lecture: Multinomial regression coefficients indicate the change in log of relative risk ratio (conditional log odds) relative to base category. Can interpret direction, significance, and relative magnitude, but hard to evaluate magnitude.

A one-year increase in education is associated with a 0.15 unit increase in the conditional log odds of believing the bible is the inspired word of God, but not to be taken literally. In other words, holding gender and religion constant, people with more years of education are more likely to believe that the bible is the inspired word of God, rather than to believe it is the “Word of God.”

A one-year increase in education is associated with a 0.19 unit increase in the conditional log odds of believing the bible is an ancient book. In other words, holding gender and religion constant, people with more years of education are more likely to believe that the bible is an ancient book, rather than to believe it is the “Word of God.”

1B

Holding gender and education constant,

Those who reported having no religious identity are most likely to believe the Bible is an ancient book relative to believing it is the “Word of God.”

Those who reported having Jewish identity are most likely to believe the Bible is the “word of God” relative to believing it is the “inspired word.”

2A

I am using data from the Health and Retirement Survey, a nationally-representative survey of U.S. older adults. The sample consists of respondents to the survey’s subsection on Widowhood and Divorce, who experienced the death of a spouse between 2018 and 2022. This subsection consists of questions about the financial impacts of the death, such as changes in income, social assistance and work hours, changes in insurance coverage, death expenses, and so on.

Dependent variable:

Source of financing funerals: Did the deceased’s insurance and estate fully cover death expenses (a.k.a. the widow reports paying less than $300 beyond the covered amount), or did the widow have to rely on selling assets & withdrawing savings, relatives & friends, charity institutions, loans, or other sources?

Independent variables:

  1. Widow’s demographic characteristics: Gender, race & ethnicity, foreign-born status
  2. Widow’s employment status: currently employed or not (note: “non-employed” includes unemployed, retired, homemaker, disabled)

2B

library(pacman)
p_load(tidyverse, broom, haven, skimr, janitor, marginaleffects, lmtest, modelsummary, flextable)

# nnet package for multinomial logit
# install.packages("nnet")
library(nnet)

# Turn off scientific notation
options(scipen = 100)
# refresh environment
rm(list = ls()) 

# set working directory to project directory
# setwd(here::here("FINAL_PROJECT_HRS_SPOUSAL_DEATH"))

# read data in relation to working directory
df <- read.csv("../Input/HRS_widows_employ_tracker_cleaned.csv")

# set thousand dollar units to aid interpretation
df$deathexpense_1k <- df$deathexpense_usd/1000 

# convert variable to factor and set base category 
df$deathexpense_sources <- as.factor(df$deathexpense_sources)
df$deathexpense_sources <- relevel(df$deathexpense_sources, ref = "insurance_estate_full")
base_category <- levels(df$deathexpense_sources)[1]
print(base_category)
[1] "insurance_estate_full"
table(df$deathexpense_sources)

insurance_estate_full        assets_savings             charities 
                  145                   153                    11 
                loans                 other     relatives_friends 
                    8                    30                    88 

The base category is “insurance_estate_full”, which stands for cases where the deceased’s insurance and estate fully covered death expenses.

model <- multinom(deathexpense_sources ~ foreign + female + employed + black_nh + hisp_allraces + non_bwh,
  data = df)
# weights:  48 (35 variable)
initial  value 632.491093 
iter  10 value 467.546076
iter  20 value 458.309198
iter  30 value 457.314866
iter  40 value 457.278160
final  value 457.278087 
converged
# logistic regression coefficients
modelsummary(list(model), 
             shape = term + response ~ statistic,
             stars = T,
             ) 
tinytable_qnkdbbhzt5zl7nj7yjc5
(1)
response Est. S.E.
+ p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001
(Intercept) assets_savings -0.420 0.274
charities -2.601*** 0.627
loans -16.989*** 0.567
other -1.556*** 0.398
relatives_friends -1.207*** 0.335
foreign assets_savings 1.775** 0.569
charities 2.857** 0.939
loans 1.019 0.999
other 1.593* 0.678
relatives_friends 0.663 0.567
female assets_savings 0.427 0.301
charities -0.031 0.675
loans -0.779 0.976
other -0.386 0.450
relatives_friends 0.139 0.355
employed assets_savings 0.799* 0.350
charities -0.655 1.114
loans 0.614 0.965
other 0.986* 0.488
relatives_friends 0.086 0.431
black_nh assets_savings -0.283 0.384
charities 0.678 0.754
loans -1.915*** 0.000
other -1.475 1.065
relatives_friends 0.859* 0.412
hisp_allraces assets_savings -1.945** 0.618
charities -1.920 1.299
loans 16.018*** 0.567
other 0.267 0.658
relatives_friends 1.294** 0.482
non_bwh assets_savings -0.879 0.605
charities -15.307*** 0.000
loans -1.611*** 0.000
other -0.204 0.879
relatives_friends -0.410 0.831
Num.Obs. 353
R2 0.253
R2 Adj. 0.252
AIC 984.6
BIC 1119.9
RMSE 0.34
# relative risk ratios
modelsummary(list(model), 
             shape = term + response ~ statistic,
             stars = T,
             exponentiate = T,
             # fmt = fmt_decimal(digits = 4),
             ) 
tinytable_gi71azc3sovn5cu8os48
(1)
response Est. S.E.
+ p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001
(Intercept) assets_savings 0.657 0.180
charities 0.074*** 0.047
loans 0.000*** 0.000
other 0.211*** 0.084
relatives_friends 0.299*** 0.100
foreign assets_savings 5.900** 3.354
charities 17.403** 16.345
loans 2.770 2.767
other 4.917* 3.335
relatives_friends 1.941 1.100
female assets_savings 1.533 0.461
charities 0.970 0.654
loans 0.459 0.448
other 0.680 0.306
relatives_friends 1.150 0.408
employed assets_savings 2.223* 0.779
charities 0.519 0.578
loans 1.848 1.783
other 2.680* 1.308
relatives_friends 1.090 0.470
black_nh assets_savings 0.754 0.289
charities 1.970 1.486
loans 0.147*** 0.000
other 0.229 0.244
relatives_friends 2.361* 0.974
hisp_allraces assets_savings 0.143** 0.088
charities 0.147 0.190
loans 9049520.771*** 5134352.527
other 1.306 0.860
relatives_friends 3.647** 1.757
non_bwh assets_savings 0.415 0.251
charities 0.000*** 0.000
loans 0.200*** 0.000
other 0.816 0.717
relatives_friends 0.664 0.551
Num.Obs. 353
R2 0.253
R2 Adj. 0.252
AIC 984.6
BIC 1119.9
RMSE 0.34

Note: I do not understand why the relative risk ratios for Hispanic respondents are absurdly high, at 253067693.401.

2C

df$deathexpense_sources <- relevel(df$deathexpense_sources, ref = "assets_savings")
base_category <- levels(df$deathexpense_sources)[1]
print(base_category)
[1] "assets_savings"

The base category here stands for cases where the widow had to sell assets or withdraw savings to cover death expenses.

model <- multinom(deathexpense_sources ~ foreign + female + employed + black_nh + hisp_allraces + non_bwh, 
  data = df)
# weights:  48 (35 variable)
initial  value 632.491093 
iter  10 value 471.682568
iter  20 value 458.342032
iter  30 value 457.341989
iter  40 value 457.278218
final  value 457.278087 
converged
# logistic regression coefficients
modelsummary(list(model), 
             shape = term + response ~ statistic,
             stars = T,
             ) 
tinytable_t0xafrvutdhmgeyz7m3g
(1)
response Est. S.E.
+ p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001
(Intercept) insurance_estate_full 0.420 0.274
charities -2.181*** 0.633
loans -19.211*** 0.619
other -1.136** 0.410
relatives_friends -0.787* 0.353
foreign insurance_estate_full -1.775** 0.568
charities 1.082 0.850
loans -0.756 1.023
other -0.182 0.631
relatives_friends -1.112+ 0.574
female insurance_estate_full -0.427 0.301
charities -0.458 0.677
loans -1.206 0.984
other -0.813+ 0.456
relatives_friends -0.288 0.372
employed insurance_estate_full -0.799* 0.350
charities -1.454 1.097
loans -0.185 0.964
other 0.187 0.466
relatives_friends -0.713+ 0.417
black_nh insurance_estate_full 0.283 0.384
charities 0.961 0.759
loans -0.535*** 0.000
other -1.193 1.068
relatives_friends 1.142** 0.429
hisp_allraces insurance_estate_full 1.945** 0.618
charities 0.025 1.292
loans 20.605*** 0.619
other 2.211** 0.719
relatives_friends 3.239*** 0.629
non_bwh insurance_estate_full 0.879 0.605
charities -12.443 664.803
loans 1.983*** 0.000
other 0.675 0.888
relatives_friends 0.469 0.868
Num.Obs. 353
R2 0.253
R2 Adj. 0.252
AIC 984.6
BIC 1119.9
RMSE 0.34
# relative risk ratios
modelsummary(list(model), 
             shape = term + response ~ statistic,
             stars = T,
             exponentiate = T,
             # fmt = fmt_decimal(digits = 4),
             ) 
tinytable_2ehxg6jp1wd2tyygwq1z
(1)
response Est. S.E.
+ p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001
(Intercept) insurance_estate_full 1.522 0.417
charities 0.113*** 0.071
loans 0.000*** 0.000
other 0.321** 0.132
relatives_friends 0.455* 0.161
foreign insurance_estate_full 0.170** 0.096
charities 2.949 2.506
loans 0.470 0.480
other 0.833 0.526
relatives_friends 0.329+ 0.189
female insurance_estate_full 0.653 0.196
charities 0.633 0.428
loans 0.299 0.295
other 0.444+ 0.202
relatives_friends 0.750 0.279
employed insurance_estate_full 0.450* 0.158
charities 0.234 0.256
loans 0.831 0.801
other 1.206 0.562
relatives_friends 0.490+ 0.204
black_nh insurance_estate_full 1.327 0.509
charities 2.614 1.985
loans 0.586*** 0.000
other 0.303 0.324
relatives_friends 3.133** 1.345
hisp_allraces insurance_estate_full 6.991** 4.319
charities 1.025 1.325
loans 888434015.333*** 549918414.195
other 9.128** 6.565
relatives_friends 25.497*** 16.050
non_bwh insurance_estate_full 2.407 1.457
charities 0.000 0.003
loans 7.267*** 0.000
other 1.964 1.743
relatives_friends 1.598 1.388
Num.Obs. 353
R2 0.253
R2 Adj. 0.252
AIC 984.6
BIC 1119.9
RMSE 0.34

2D

df$deathexpense_sources <- relevel(df$deathexpense_sources, ref = "insurance_estate_full")
model <- multinom(deathexpense_sources ~ foreign + female + employed + black_nh + hisp_allraces + non_bwh, 
  data = df)
# weights:  48 (35 variable)
initial  value 632.491093 
iter  10 value 467.546076
iter  20 value 458.309198
iter  30 value 457.314866
iter  40 value 457.278160
final  value 457.278087 
converged
# Save AME output 
ame1 <- avg_slopes(model)

# Make table with AME output
modelsummary(ame1, 
             shape = term : contrast ~ group,
             stars = T,
             notes = str_c("N = ", glance(model)$nobs),
             title = "Multinomial Logit")
tinytable_b36zz5olc9u7e5f8t3do
(1)
Multinomial Logit
assets_savings charities insurance_estate_full loans other relatives_friends
+ p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001
N = 353
black_nh 1 - 0 -0.092 0.023 -0.023 -0.015** -0.074** 0.182**
(0.061) (0.030) (0.067) (0.006) (0.026) (0.067)
employed 1 - 0 0.136* -0.024 -0.120* 0.004 0.055 -0.051
(0.063) (0.017) (0.059) (0.015) (0.041) (0.046)
female 1 - 0 0.090+ -0.005 -0.040 -0.015 -0.042 0.013
(0.051) (0.020) (0.055) (0.020) (0.036) (0.045)
foreign 1 - 0 0.195* 0.094 -0.262*** 0.003 0.038 -0.068
(0.090) (0.072) (0.057) (0.013) (0.047) (0.050)
hisp_allraces 1 - 0 -0.345*** -0.035* -0.036 0.077+ 0.027 0.312***
(0.042) (0.017) (0.082) (0.043) (0.044) (0.084)
non_bwh 1 - 0 -0.122 -0.033*** 0.152 -0.012* 0.020 -0.005
(0.087) (0.010) (0.124) (0.005) (0.071) (0.112)
Num.Obs. 353
R2 0.253
R2 Adj. 0.252
AIC 984.6
BIC 1119.9
RMSE 0.34

It seems that Hispanic identity has the most impact on the probability that someone relies on relatives and friend (31% higher probability than non-Hispanics) and on assets and savings (35% lower probability than non-Hispanics).

2E

plot_predictions(model,
                 # the second argument must be "group"
                 condition = c("foreign", "group")) 

2F

Holding all other variables constant, to cover their spouse’s death expenses,

  • Foreign-born widows are significantly less likely than US-born widows to have their spouse’s death expenses fully covered by their spouse’s insurance or estate.

  • Hispanic widows are significantly less likely than non-Hispanic widows to relieve themselves of assets & savings and significantly more likely to rely on relatives and friends.